Unit ToneGenerator;
(*   NOTE:  This IS the tone generator in the Tone Generator...
Removed the save attempt and killed the menu 2005-02-26
 V2.2.2  1997 Oct 06  Version for Delphi 3.01
                     Don't progress programmed mode
                     Add Pink noise mode
*)

Interface

{$A-}

Uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  MMSystem, mmErrMsg, ComCtrls, Menus, AxCtrls, OleCtrls, DbOleCtl,
  _GClass, AbGradient;

Const
  sample_rate = 44100;                  // i.e. best CD quality
  // note: 10ms -> exactly 441 samples
  sine_table_samples = 1 Shl 15;        // number of samples in sine table
  max_buffer_samples = 57330;           // size of output buffer for 1.3 seconds
  // four times this in bytes
  pink_noise_filename = 'pink.wav';

Type
  audio_sample = -32767..32767;         // for 16-bit audio

Type
  PSineTable = ^TSineTable;             // sine value store
  TSineTable = Array[0..sine_table_samples - 1] Of audio_sample;

  PMonoBuffer = ^TMonoBuffer;           // pink noise buffer type
  TMonoBuffer = Array[0..max_buffer_samples - 1] Of audio_sample; // 1-channel

  PBuffer = ^TBuffer;                   // output buffer type
  TBuffer = Array[0..2 * max_buffer_samples - 1] Of audio_sample; // 2-channels

  ranges = (lf, mf, hf, wide);          // sweep ranges
  modes = (logarithmic, linear);        // sweep modes
  speeds = (fast_stepped, fast_smooth, white, pink, slow, programmed, manual, no_sweep); // sweep speeds
  out_levels = (phase_normal, phase_reverse, independent); // output modes

  out_freqs = Array[0..0] Of extended;

Type
  TfrmToneGenerator = Class(TForm)
    pnlMain: TPanel;
    gbFrequencyRange: TRadioGroup;
    grpSweepMode: TRadioGroup;
    grpSweepSpeed: TRadioGroup;
    edtF1: TEdit;
    Label1: TLabel;
    edtF2: TEdit;
    Label2: TLabel;
    lblFnow: TLabel;
    grpOctaveMarkers: TGroupBox;
    chkOctaveMarker: TCheckBox;
    lblLastMarker: TLabel;
    GroupBox1: TGroupBox;
    tkbLeftLevel: TTrackBar;
    tkbRightLevel: TTrackBar;
    lblLeftLevel: TLabel;
    lblRightLevel: TLabel;
    Label3: TLabel;
    grpChannels: TRadioGroup;
    chkLeft: TCheckBox;
    chkRight: TCheckBox;
    grpSetFrequency: TGroupBox;
    tkbLeftFrequency: TTrackBar;
    tkbRightFrequency: TTrackBar;
    chkLockFrequencies: TCheckBox;
    lblFMaxR: TLabel;
    lblFMinR: TLabel;
    lblFMaxL: TLabel;
    lblFMinL: TLabel;
    lblFLeft: TLabel;
    lblFRight: TLabel;
    Timer1: TTimer;
    SaveDialog1: TSaveDialog;
    AbGradient1: TAbGradient;
    btnStart: TButton;
    btnExit: TButton;
    Procedure btnExitClick(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure grpSweepModeClick(Sender: TObject);
    Procedure grpSweepSpeedClick(Sender: TObject);
    Procedure gbFrequencyRangeClick(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure btnStartClick(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Procedure btnStartKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
    Procedure tkbLeftLevelChange(Sender: TObject);
    Procedure tkbRightLevelChange(Sender: TObject);
    Procedure grpChannelsClick(Sender: TObject);
    Procedure chkLeftClick(Sender: TObject);
    Procedure tkbLeftFrequencyChange(Sender: TObject);
    Procedure tkbRightFrequencyChange(Sender: TObject);
    Procedure chkLockFrequenciesClick(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
    Procedure edtF1Change(Sender: TObject);
    Procedure edtF2Change(Sender: TObject);
    Procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
    left_angle, right_angle: integer;   // current sine wave angles
    left_sine_table, right_sine_table:
    PSineTable;                         // pre-stored sine-wave values
    left_sine_table_valid,
      right_sine_table_valid: boolean;  // table-valid flags
    pink_noise_buffer: PMonoBuffer;     // pre-stored pink noise
    hWave_hdr1: HGlobal;                // wave header handles
    hWave_hdr2: HGlobal;
    p_wave_hdr1: PWaveHdr;              // wave header pointers
    p_wave_hdr2: PWaveHdr;
    hBuffer1: HGlobal;                  // output buffer handles
    hBuffer2: HGlobal;
    p_buffer1: PBuffer;                 // output buffer pointers
    p_buffer2: PBuffer;
    buffer_bytes: integer;              // max number of bytes in each output buffer
    f_min, f_max: integer;              // limits of sweep range
    buffers_written, buffers_played:
    integer;                            // for tracking the slow sweep
    all_written: boolean;               // so we know when to stop the sweep
    fl, fr: extended;                   // current left and right frequencies
    f_ratio, f_step: extended;
    last_f: extended;
    f_inv_ratio: extended;
    direction: (up, down, holding);     // for manual sweep mode
    current_octave: integer;            // to know whether to add a marker
    next_octave: integer;
    do_markers: boolean;                // true if makers (balnks) are required
    hWave_out: HWaveOut;                // handle to wave out device
    pcm: TWaveFormatEx;                 // wave format descriptor
    sweep_running: boolean;
    shutoff: boolean;
    closing: boolean;
    closed: boolean;
    log_lin: modes;
    speed: speeds;
    range: ranges;
    out_level: out_levels;              // in-phase, out-of-phase or independent
    locked_frequencies: boolean;        // true for same freq in left and right
    chunk_freq: ^out_freqs;
    slow_sweep_time: integer;           // duration of slow sweep (milliseconds)
    slow_sweep_chunks: integer;         // the number of chunks in the buffer
    chunk_ms: integer;                  // duration of each chunk in milliseconds
    left_amplitude: extended;           // 1.0 is 0dB, 0.5 is -6dB etc
    right_amplitude: extended;
    present_left_amplitude: extended;   // to tell if the amplitude has changed
    present_right_amplitude: extended;
    Procedure restart_sweep;
    Procedure stop_sweep;
    Procedure start_sweep;
    Procedure level_changed;

    // call-backs from waveform out functions
    Procedure mm_wom_Open(Var Msg: TMessage); message mm_wom_open;
    Procedure mm_wom_Done(Var Msg: TMessage); message mm_wom_done;
    Procedure mm_wom_Close(Var Msg: TMessage); message mm_wom_close;

    // procedure just to fill a buffer - independent of mode
    Function fill_buffer(h: HMMIO): integer;
    Function fill_single_sweep_bfr(bfr: PBuffer; num_freqs: integer): integer;
    Function fill_white_noise_bfr(bfr: PBuffer): integer;
    Function fill_pink_noise_bfr(bfr: PBuffer): integer;

    // copies from sine table into buffer, offset if right channel sine table
    Procedure fill_buffer_with_sinewave(
      sine_table: PSineTable;
      bfr: pBuffer;
      f: extended;
      Var angle: integer; index, samples: integer);

    Procedure write_next_buffer(header: PWaveHdr);

    // populate a sine table for the present amplitude
    Procedure build_sine_table(magnitude: extended; table: PSineTable);
    Procedure build_left_sine_table;    // fill left channel sine table
    Procedure build_right_sine_table;   // fill right channel sine table

    Function get_octave(f: extended): integer;
    Function read_pink_noise_file(Const filename: String): boolean;
  public
    { Public declarations }
    Function ShutDown: boolean;
  End;

Var
  frmToneGenerator: TfrmToneGenerator;
  h: HMMIO;

Implementation

Uses
  Math, ProgramForm;

{$R *.DFM}
//{$R LED.DCR}

Procedure TfrmToneGenerator.FormCreate(Sender:
  TObject);
Var
  dB: integer;
Begin
  // set the initial amplitude slider positions for -12dB
  tkbLeftLevel.Position := 12;
  tkbRightLevel.Position := 12;

  // generate the labels for the dB markings on the amplitude sliders
  For dB := 0 To 25 Do
    If (dB Mod 5) = 0 Then              // add labels every 5 dB
      With TLabel.Create(GroupBox1) Do
      Begin
        Parent := GroupBox1;
        Caption := IntToStr(-dB);
        Left := 0;
        Top := tkbLeftLevel.Top + 8 + (dB * (tkbLeftLevel.Height - 27)) Div 26;
        Width := GroupBox1.Width;       // span the whole box transparently
        Alignment := taCenter;          // then centre the text in the box
        AutoSize := False;              // keeping the size intact
        Transparent := True;
        If dB < 6 {// set colour according to level} Then
          Font.Color := clRed
        Else
          If dB < 11 Then
            Font.Color := clYellow
          Else
            Font.Color := clGreen;
      End;

  // set the default positions for the RadioGroup boxes, this forces the
  // dependant variables and the label captions to be set
  grpSweepMode.ItemIndex := 1;
  gbFrequencyRange.ItemIndex := 2;
  grpSweepSpeed.ItemIndex := 0;
  grpChannels.ItemIndex := 0;

  // get the memory required for wave headers
  // this code is probably irrelevant in the Win32 environment
  hWave_hdr1 := GlobalAlloc(gHnd Or gMem_Share, SizeOf(TWaveHdr));
  p_wave_hdr1 := pWaveHdr(GlobalLock(hWave_hdr1));
  hWave_hdr2 := GlobalAlloc(gHnd Or gMem_Share, SizeOf(TWaveHdr));
  p_wave_hdr2 := pWaveHdr(GlobalLock(hWave_hdr2));

  // define nominal values for sweep - may be overwritten in programmed mode
  chunk_ms := 250;                      // 250ms for four freq's per second
  slow_sweep_time := 45000;             // and 45 seconds for the sweep
  slow_sweep_chunks := slow_sweep_time Div chunk_ms;

  // estimate of reasonable output buffer size for 1.3 seconds of audio
  // this should make the active portion of the fast sweep just 50ms per chunk
  // double the number of bytes to get samples per channel
  buffer_bytes := 2 * (13 * sample_rate) Div 10;
  If buffer_bytes > 2 * max_buffer_samples Then
    buffer_bytes := 2 * max_buffer_samples;

  // get the memory required for output buffers
  // the final * 2 is for 2 channels
  hBuffer1 := GlobalAlloc(gHnd Or gMem_Share, buffer_bytes * 2);
  p_buffer1 := pBuffer(GlobalLock(hBuffer1));
  hBuffer2 := GlobalAlloc(gHnd Or gMem_Share, buffer_bytes * 2);
  p_buffer2 := pBuffer(GlobalLock(hBuffer2));
  If (hBuffer1 = 0) Or (hBuffer2 = 0) Then
    ShowMessage('Failed to get memory for output buffers');

  hWave_out := 0;

  // get memory for the sine-wave tables and note they haven't yet been built
  GetMem(left_sine_table, SizeOf(TSineTable));
  GetMem(right_sine_table, SizeOf(TSineTable));
  If (left_sine_table = Nil) Or (right_sine_table = Nil) Then
    ShowMessage('Failed to get memory for sine-wave tables');
  left_sine_table_valid := False;
  right_sine_table_valid := False;

  pink_noise_buffer := Nil;

  locked_frequencies := True;           // assume we're working normally

  // set present amplitude to an invalid value
  present_left_amplitude := -1.0;
  present_right_amplitude := -1.0;
  out_level := phase_normal;

  // fill in the standard header
  With pcm Do
  Begin
    wFormatTag := wave_Format_PCM;      // it's PCM data
    nChannels := 2;                     // 2 channels
    nSamplesPerSec := sample_rate;      // set the 44.1KHz rate
    nAvgBytesPerSec := 4 *
      sample_rate;                      // two bytes per sample
    nBlockAlign := 4;                   // for 2-channel 16-bit audio
    wBitsPerSample := 16;               // 16-bit audio
    cbSize := 0;
  End;

  // set other state variables
  shutoff := False;
  closing := False;
  sweep_running := False;
  level_changed;                        // get a valid value for the amplitudes
End;

Function TfrmToneGenerator.ShutDown: boolean;

Begin
  FormDestroy(Self);

End;

Procedure TfrmToneGenerator.FormDestroy(Sender: TObject);
Begin

  stop_sweep;
  shutoff := true;
  // return allocated memory
  GlobalUnlock(hWave_hdr1);
  GlobalFree(hWave_hdr1);
  GlobalUnlock(hBuffer1);
  GlobalFree(hBuffer1);
  GlobalUnlock(hWave_hdr2);
  GlobalFree(hWave_hdr2);
  GlobalUnlock(hBuffer2);
  GlobalFree(hBuffer2);
  (*
  FreeMem(left_sine_table, SizeOf(TSineTable));
  FreeMem(right_sine_table, SizeOf(TSineTable));
  if pink_noise_buffer <> nil then
    FreeMem(pink_noise_buffer);
    *)
End;

Procedure TfrmToneGenerator.btnExitClick(Sender:
  TObject);
Begin
  Close;
End;

Procedure TfrmToneGenerator.level_changed;
// Called whenever the sine tables may need to be re-done,
// such as when the output level has changed in some way.

  Function dB_to_amplitude(db:
    integer): extended;
  Begin
    Result := 1.0;
    If dB <> 0 Then
      Result := power(10.0, -dB / 20.0);
  End;

Begin
  left_amplitude := 0.0;
  right_amplitude := 0.0;

  If chkLeft.Checked {// left channel open?} Then
  Begin                                 // convert dB to amplitude value
    left_amplitude := dB_to_amplitude(tkbLeftLevel.Position);
    lblLeftLevel.Caption := '-' + IntToStr(tkbLeftLevel.Position);
  End
  Else
    lblLeftLevel.Caption := 'Off';

  If chkRight.Checked {// right channel open?} Then
  Begin
    right_amplitude := dB_to_amplitude(tkbRightLevel.Position);
    lblRightLevel.Caption := '-' + IntToStr(tkbRightLevel.Position);
  End
  Else
    lblRightLevel.Caption := 'Off';

  // If the level may have changed, queue up a possible restart of the sweep.
  // This allows for several small changes to be made without the continual
  // interruption of the sweep re-starting.  It also seems that unless there
  // is _some_ delay, my code can't handle repeated sweep restarts, probably
  // due to messages becoming lost.....
  Timer1.Enabled := True;               // 1 second delay
End;

Procedure TfrmToneGenerator.Timer1Timer(Sender:
  TObject);
Begin
  Timer1.Enabled := False;              // this is a single-shot timer
  lblFnow.Caption := '';
  // see if level is different - if so, we need to regenerate the sine table
  If present_left_amplitude <> left_amplitude Then
    left_sine_table_valid := False;
  If present_right_amplitude <> right_amplitude {// and for the right channel} Then
    right_sine_table_valid := False;
  If (present_left_amplitude <> left_amplitude) Or (present_right_amplitude <> right_amplitude) Then
    restart_sweep;
End;

Procedure
  TfrmToneGenerator.grpSweepModeClick(Sender: TObject);
// This is typical of the code for all the RadioGroups.  Find
// the current string and decode it.  Set a label caption equal
// to the decoded value, often just the current string
Var
  current: String;
Begin
  current := grpSweepMode.Items.Strings[grpSweepMode.ItemIndex];
  If current = 'Linear' Then
    log_lin := linear;
  If current = 'Log' Then
    log_lin := logarithmic;
  lblFnow.Caption := LowerCase(current);
  // The sweep parameters have changed, so restart any sweep in progress
  restart_sweep;
End;

Procedure
  TfrmToneGenerator.grpSweepSpeedClick(Sender:
  TObject);
Var
  current: String;
  chunk_duration: integer;
  chunk_samples: integer;
Begin
  // set "speed" according to the decoded string value
  current := grpSweepSpeed.Items.Strings[grpSweepSpeed.ItemIndex];
  If current = 'Slow' Then
    speed := slow;
  If current = 'Programmed' Then
    speed := programmed;
  If current = 'Manual' Then
    speed := manual;
  If current = 'Fast (stepped)' Then
    speed := fast_stepped;
  If current = 'Fast (smooth)' Then
    speed := fast_smooth;
  If current = 'No sweep' Then
    speed := no_sweep;
  If current = 'White noise' Then
    speed := white;
  If current = 'Pink noise' Then
  Begin
    // speed := pink;
    speed := white;
    showmessage('Pink not supported in this release (using White)...');
  End;

  // show the lower frequency edit box if appropriate
  Case speed Of
    slow, programmed, manual, fast_stepped, fast_smooth, no_sweep: edtF1.Visible := True;
    white, pink: edtF1.Visible := False;
  End;

  If speed = programmed Then
  Begin
    With frmProgram Do
    Begin
      TotalDuration := slow_sweep_time;
      FrequencySteps := slow_sweep_chunks;
      StartFrequency := f_min;
      EndFrequency := f_max;
      LevelList := lblLeftLevel.Caption;
      If ShowModal = mrOK Then
      Begin
        chunk_duration := TotalDuration Div FrequencySteps; // in milliseconds
        If chunk_duration < 100 Then
          Application.MessageBox
            ('Using your requested values results in steps that last less ' +
            'than 100ms.'#13'This may cause gaps in the audible output',
            'Sweep too short or too many steps',
            MB_ICONWARNING);
        chunk_samples := chunk_duration * sample_rate Div 1000;
        If chunk_samples > max_buffer_samples Then
        Begin
          chunk_samples := max_buffer_samples;
          chunk_duration := (chunk_samples * 1000) Div sample_rate;
          FrequencySteps := TotalDuration Div chunk_duration;
          Application.MessageBox(PChar('Using you requested values results in ' +
            'steps that exceed 1.3 seconds - outside the program''s range.'#13 +
            'Number of steps will be increased to ' +
            IntToStr(FrequencySteps)),
            'Sweep too long or too few steps',
            MB_ICONWARNING);
        End;
        edtF1.Text := IntToStr(StartFrequency);
        edtF2.Text := IntToStr(EndFrequency);
        slow_sweep_time := TotalDuration;
        slow_sweep_chunks := FrequencySteps;
        chunk_ms := chunk_duration;
      End;
    End;
  End;

  // show the second frequency edit box if appropriate
  Case speed Of
    slow, programmed, manual, fast_stepped, fast_smooth: edtF2.Visible := True;
    white, pink, no_sweep: edtF2.Visible := False;
  End;

  If speed = slow Then
  Begin
    chkOctaveMarker.Enabled := True;
    lblLastMarker.Enabled := True;
  End
  Else
  Begin
    lblLastMarker.Enabled := False;
    chkOctaveMarker.Enabled := False;
  End;

  lblFLeft.Caption := edtF1.Text;
  lblFRight.Caption := edtF1.Text;

  If speed = manual Then
  Begin                                 // set the paramters for the freq trackbar
    With tkbLeftFrequency Do
    Begin
      Max := slow_sweep_chunks;
      Min := 1;
      LineSize := 1;
      PageSize := LineSize * 10;
      Enabled := True;
    End;
    With tkbRightFrequency Do
    Begin
      Max := tkbLeftFrequency.Max;      // same as the left trackbar
      Min := 1;
      LineSize := 1;
      PageSize := LineSize * 10;
      Enabled := True;
    End;
    chkLockFrequencies.Enabled :=
      True;
    lblFMinL.Enabled := True;
    lblFMinR.Enabled := True;
    lblFMaxL.Enabled := True;
    lblFMaxR.Enabled := True;
    lblFLeft.Enabled := True;
    lblFRight.Enabled := True;
  End
  Else
  Begin
    tkbLeftFrequency.Enabled := False;
    tkbRightFrequency.Enabled := False;
    chkLockFrequencies.Enabled := False;
    lblFMinL.Enabled := False;
    lblFMinR.Enabled := False;
    lblFMaxL.Enabled := False;
    lblFMaxR.Enabled := False;
    lblFLeft.Enabled := False;
    lblFRight.Enabled := False;
  End;

  With tkbLeftFrequency Do
    Position := Max;
  With tkbRightFrequency Do
    Position := Max;

  lblFnow.Caption := LowerCase(current);
  direction := holding;
  restart_sweep;
End;

Procedure
  TfrmToneGenerator.gbFrequencyRangeClick(Sender:
  TObject);
Var
  f1, f2: integer;
  current: String;
Begin
  // decode the settings into "range" and hence a pair of frequencies
  current := gbFrequencyRange.Items.Strings[gbFrequencyRange.ItemIndex];
  If current = 'Wide  (20Hz .. 20KHz)' Then
    range := wide;
  If current = 'HF  (1KHz .. 15KHz)' Then
    range := hf;
  If current = 'Speech  (300Hz .. 3KHz)' Then
    range := mf;
  If current = 'LF  (50Hz .. 1KHz)' Then
    range := lf;
  Case range Of
    lf:
      Begin
        f1 := 50;
        f2 := 1000;
      End;
    mf:
      Begin
        f1 := 300;
        f2 := 3000;
      End;
    hf:
      Begin
        f1 := 1000;
        f2 := 15000;
      End;
    wide:
      Begin
        f1 := 20;
        f2 := 20000;
      End;
  Else
    Begin
      f1 := 300;
      f2 := 3000;
    End;
  End;

  // set f_min and f_max so that frequency slide labels display correctly
  f_min := f1;
  f_max := f2;

  // record the new frequency range in the Edit boxes and trackbar labels
  edtF1.Text := IntToStr(f1);
  edtF2.Text := IntToStr(f2);

  Case range Of
    lf: lblFnow.Caption := 'lf';
    mf: lblFnow.Caption := 'mf';
    hf: lblFnow.Caption := 'hf';
    wide: lblFnow.Caption := 'wide';
  End;

  restart_sweep;
End;

Procedure TfrmToneGenerator.restart_sweep;
Begin
  If sweep_running Then
    start_sweep;
End;

Procedure TfrmToneGenerator.stop_sweep;
Begin
  // Is a sweep running?  If so, stop it
  If sweep_running Then
  Begin
    shutoff := true;
    waveOutReset(hWave_out);
    sweep_running := false;

    closed := false;
    Repeat
      Application.ProcessMessages;
    Until closed;
  End
End;

Procedure TfrmToneGenerator.start_sweep;
Var
  open_status: MMRESULT;
  code: integer;
Begin
  If sweep_running Then
    stop_sweep;

  // try to convert the text in the edit boxes to numbers
  Val(edtF1.Text, f_min, code);
  If code <> 0 Then
    f_min := 150;
  Val(edtF2.Text, f_max, code);
  If code <> 0 Then
    f_max := 300;

  // just for the slow sweep, see if the octave marker gaps are required
  do_markers := chkOctaveMarker.State =
    cbChecked;
  lblLastMarker.Caption := 'Last at:';

  left_angle := 0;
  right_angle := 0;

  shutoff := False;
  // try and open the wave device for our format of wave data
  // will result in a mm_wave_open message
  open_status :=
    waveOutOpen(@hWave_out, 0, @pcm,
    Handle, 0, callback_window);

  If open_status = 0 Then
  Begin
    // prepare to receive the WaveOutOpen message to actually start sending data
    sweep_running := true;
    grpChannels.Enabled := False;       // we don't change this while running
    grpOctaveMarkers.Enabled :=
      False;
    chkOctaveMarker.Enabled := False;
    edtF1.Enabled := False;
    edtF2.Enabled := False;
    closed := false;
    Case speed Of
      slow, programmed, no_sweep,
        manual:
        Begin
          lblFnow.Caption :=
            IntToStr(f_min) + ' Hz';
          lblFnow.Visible := True;
        End;
    End;
    If speed = programmed Then
    Begin
      tkbLeftLevel.Enabled := False;
      tkbRightLevel.Enabled := False;
      lblLeftLevel.Enabled := False;
      lblRightLevel.Enabled := False;
      chkLeft.Enabled := False;
      chkRight.Enabled := False;
      gbFrequencyRange.Enabled := False;
      grpSweepMode.Enabled := False;
      grpSweepSpeed.Enabled := False;
    End;
  End
  Else
  Begin
    sweep_running := false;
    hWave_out := 0;
    // inform user of failure
    // translate the most common error into English!
    If open_status = waverr_BadFormat Then
      MessageDlg('Sorry, your sound card does not support' + #13#10 + 'stereo, 16-bit, '
        + FloatToStr(sample_rate / 1000) + 'KHz audio', mtWarning, [mbOK], 0)
    Else
      MessageDlg('Error opening waveform audio.' + #13 + translate_mm_error(open_status), mtWarning, [mbOK], 0);
  End;
End;

Procedure TfrmToneGenerator.btnStartClick(Sender:
  TObject);
Begin
  {is a sweep running?  if so, stop it}
  If sweep_running Then
    stop_sweep
  Else
    start_sweep;
End;

Function TfrmToneGenerator.fill_buffer(h: HMMIO): integer;
Var
  samples: integer;
  chunks: integer;
  buffer_fill: integer;
  chunk: integer;                       // loop over chunks for slow speed
  f: extended;                          // and the variable used to compute the freqs
Begin
  // assume we fail to produce any results
  Result := 0;

  // build sine-wave tables if required
  If Not left_sine_table_valid Then
    build_left_sine_table;
  If Not right_sine_table_valid Then
    build_right_sine_table;
  chunk_freq := Nil;

  Case speed Of
    fast_smooth, fast_stepped, white,
      pink:
      Begin
        // fill in a single buffer that is repeated, fast sweep or white noise
        If speed = white Then
          samples := fill_white_noise_bfr(p_buffer1) // white noise
        Else
          If speed = pink Then
            samples := fill_pink_noise_bfr(p_buffer1) // pink noise
          Else
            If speed = fast_smooth Then
              samples := fill_single_sweep_bfr(p_buffer1, 1000) // many frequencies
            Else
              samples := fill_single_sweep_bfr(p_buffer1, 20); // just 20 frequencies
        If h <> 0 Then
          mmioWrite(h, @p_buffer1^, samples * 4); // four bytes per sample
        Result := samples;              // return number created/written
      End;
    slow, programmed, manual, no_sweep:
      Begin
        // compute number of chunks in the sweep, ensure it's at least two
        // aim for about four different frequencies per second
        chunks := slow_sweep_chunks;
        If chunks < 2 Then
          chunks := 2;
        // one sample occupies 2 bytes, 2 channels occupy 4 bytes, determine
        // number of samples in one chunk multipled by 4 to get filled bytes
        buffer_fill := chunk_ms * sample_rate Div 1000; // samples per chunk
        buffer_fill := 4 * buffer_fill; // bytes per buffer
        f_ratio := exp(ln(f_max / f_min) / (chunks - 1)); // per step up
        f_inv_ratio := 1.0 / f_ratio;   // and down
        f_step := (f_max + 0.01 - f_min) / (chunks - 1);
        fl := f_min;
        fr := fl;
        If speed = manual Then
        Begin
          tkbLeftFrequency.OnChange(Self); // tell trackbars that
          tkbRightFrequency.OnChange(Self); // the freqs have changed
        End;
        // build up list of chunk freqs - will use buffers_written as index
        If (speed = slow) Or (speed = programmed) Then
        Begin
          // get frequency list memory, is freed either here or during
          // processing the mm_wom_close message
          GetMem(chunk_freq, slow_sweep_chunks * SizeOf(Extended));
          f := f_min;
          chunk_freq^[0] := f;          // define sweep base frequency
          For chunk := 1 To slow_sweep_chunks - 1 Do
          Begin
            If log_lin = linear Then
              f := f + f_step
            Else
              f := f * f_ratio;
            chunk_freq^[chunk] := f;    // define next sweep frequency
          End;
          fl := chunk_freq[0];          // current f is now base frequency
          fr := fl;                     // and on the right channel as well
          If (h <> 0) Then              // emulate the sweep
          Begin
            Screen.Cursor := crHourGlass;
            For chunk := 0 To slow_sweep_chunks - 1 Do
            Begin
              fl := chunk_freq^[chunk];
              fr := fl;                 // make the right channel the same frequency
              fill_buffer_with_sinewave(left_sine_table, p_buffer1, fl, left_angle, 0, buffer_fill Div 4); // left channel samples
              fill_buffer_with_sinewave(right_sine_table, p_buffer1, fr, right_angle, 0, buffer_fill Div 4); // right channel samples
              mmioWrite(h, @p_buffer1^, buffer_fill); // write the buffer
            End;
            Screen.Cursor := crDefault;
            FreeMem(chunk_freq);
            chunk_freq := Nil;
          End;
        End;
        current_octave := get_octave(fl); // note the starting octave
        next_octave := current_octave;
        p_wave_hdr1^.dwBufferLength := buffer_fill; // actual buffer sizes
        p_wave_hdr2^.dwBufferLength := buffer_fill;
      End;
  End;
End;

Procedure TfrmToneGenerator.mm_wom_open(Var Msg:
  tMessage);
// This code handles the WaveOutOpen message by writing two buffers of data
// to the wave device.  Plus other miscellaneous housekeeping.
Var
  samples: integer;                     // max valid sample in the buffer
Begin
  btnStart.Caption := '&STOP';          // first, tell the user how to stop the sound!

  // build sine-wave tables if required
  If Not left_sine_table_valid Then
    build_left_sine_table;
  If Not right_sine_table_valid Then
    build_right_sine_table;

  // populate the first wave header
  With p_wave_hdr1^ Do
  Begin
    lpData := pChar(p_buffer1);         // pointer to the data
    dwBufferLength := 0;                // fill in size later
    dwBytesRecorded := 0;
    dwUser := 0;
    dwFlags := 0;
    dwLoops := 1;                       // just a single loop
    lpNext := Nil;
    reserved := 0;
  End;

  // populate the second wave header
  p_wave_hdr2^ := p_wave_hdr1^;         // copy most of the data
  p_wave_hdr2^.lpData := pChar(p_buffer2); // except the buffer address!

  // fill in a single buffer that is repeated, fast sweep or white/pink noise
  // for a slow or single sweep, this sets up the frequencies
  samples := fill_buffer(0);

  Case speed Of
    fast_smooth, fast_stepped, white,
      pink:
      Begin
        With p_wave_hdr1^ Do
        Begin
          dwBufferLength := 4 *
            samples;                    // convert samples to bytes
          dwFlags := whdr_BeginLoop
            Or
            whdr_EndLoop;               // repeating buffer
          //dwLoops := -1;                              // a fair number of loops
          dwLoops := $FFFFFFFF;
        End;
        // prepare both headers but only write the first (infinite loops)
        waveOutPrepareHeader(hWave_out,
          p_wave_hdr1,
          SizeOf(TWaveHdr));
        // mm_wom_close will unprepare both headers, so prepare this one anyhow
        waveOutPrepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
        waveOutWrite(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
      End;
    slow, programmed, manual, no_sweep:
      Begin
        buffers_played := 0;
        buffers_written := 0;
        all_written := False;
        // now write the first two buffers into the wave output
        // this will result in two mm_wom_done messages
        waveOutPrepareHeader(hWave_out,
          p_wave_hdr1,
          SizeOf(TWaveHdr));
        write_next_buffer(p_wave_hdr1);
        waveOutPrepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
        write_next_buffer(p_wave_hdr2);
      End;
  End;
  //LED1.StyleOnColor := clLime;
End;

Procedure
  TfrmToneGenerator.write_next_buffer(header:
  pWaveHdr);
Begin
  If shutoff Then
    Exit;
  If all_written Then
    Exit;
  With header^ Do
  Begin
    // check to see if a marker is required for the next buffer write
    If (speed = slow) And (do_markers)
      And (current_octave <> next_octave) Then // marker required - fill buffer with silence for both channels
    Begin
      FillChar(lpData^, dwBufferLength, 0);
      current_octave := next_octave;    // update where we are
      lblLastMarker.Caption := 'Last at:' + #13 + Format('%.0f Hz', [fl]);
    End
    Else                                // not required - fill buffer with sinewave data for both channels
    Begin
      fill_buffer_with_sinewave(left_sine_table, pBuffer(lpData), fl, left_angle, 0, dwBufferLength Div 4); // left channel samples
      fill_buffer_with_sinewave(right_sine_table, pBuffer(lpData), fr, right_angle, 0, dwBufferLength Div 4); // right channel samples
    End;
    dwUser := round(fl);                // note the frequency as an integer in the user field
  End;
  last_f := fl;

  // Write the buffer as soon as possible, will result in a mm_wom_done message
  waveOutWrite(hWave_out, header, SizeOf(TWaveHdr));
  Inc(buffers_written);                 // bump the number of buffers written

  // change the frequency as required
  Case speed Of
    no_sweep: ;                         // no frequency change
    manual:
      Begin                             // manual frequency change
        Case direction Of
          up:
            Begin
              If log_lin = linear Then
                fl := fl + f_step
              Else
                fl := fl * f_ratio;
              fr := fl;
              // check to see if we've reached the maximum frequency
              If fl >= f_max Then
                direction := down;
            End;
          down:
            Begin
              If log_lin = linear Then
                fl := fl - f_step
              Else
                fl := fl * f_inv_ratio;
              fr := fl;
              // check to see if we've reached the maximum frequency
              If fl <= f_min Then
                direction := up;
            End;
        Else
          // do nothing in the "holding frequency" case
        End;
        direction := holding;
      End;
  Else
    Begin                               // normal frequency sweep
      all_written := buffers_written >= slow_sweep_chunks;
      If Not all_written Then
      Begin
        fl := chunk_freq^[buffers_written];
        fr := fl;                       // and make the right channel the same frequency
        next_octave := get_octave(fl);
      End;
    End;
  End;
End;

Procedure TfrmToneGenerator.mm_wom_done(Var Msg:
  tMessage);
// handle the wave out done message by writing the next buffer, if required
Var
  free_header: pWaveHdr;
Begin
  Case speed Of
    fast_smooth, fast_stepped, white, pink: ; // nothing to do
    slow, programmed, manual, no_sweep:
      Begin
        // note the fact that another buffer has been completed
        Inc(buffers_played);
        // point to wave header just completed, i.e. the next free buffer
        free_header := pWaveHdr(msg.lParam);
        If Not shutoff Then
        Begin
          If buffers_played >= buffers_written Then
          Begin
            // everything written has been played
            shutoff := true;
            sweep_running := false;
            closing := false;           // say we're not closing just yet
          End
          Else
          Begin
            // make a note of the last frequency for the user
            lblFnow.Caption := Format('%.0f Hz', [last_f]);
            // and write the next buffer, re-using the one just played
            write_next_buffer(free_header);
          End
        End;
      End;
  End;
  If shutoff Then
  Begin
    waveOutReset(hWave_out);
    waveOutClose(hWave_out);
  End;
End;

Procedure TfrmToneGenerator.mm_wom_close(Var Msg:
  tMessage);
// handle the wave out close message, release the wave headers
Begin
  waveOutUnprepareHeader(hWave_out, p_wave_hdr1, SizeOf(TWaveHdr));
  waveOutUnprepareHeader(hWave_out, p_wave_hdr2, SizeOf(TWaveHdr));
  p_wave_hdr1 := pWaveHdr(GlobalLock(hWave_hdr1));
  If p_wave_hdr1 = Nil Then
    ShowMessage('Failed to re-lock buffer p_wave_hdr1!');
  p_wave_hdr2 := pWaveHdr(GlobalLock(hWave_hdr2));
  If p_wave_hdr2 = Nil Then
    ShowMessage('Failed to re-lock buffer p_wave_hdr2!');
  If chunk_freq <> Nil Then
    FreeMem(chunk_freq);
  lblFnow.Visible := False;
  btnStart.Caption := '&Start';
  grpChannels.Enabled := True;          // restore the output channels options group
  grpOctaveMarkers.Enabled := True;
  gbFrequencyRange.Enabled := True;
  grpSweepMode.Enabled := True;
  grpSweepSpeed.Enabled := True;
  chkOctaveMarker.Enabled := lblLastMarker.Enabled;
  edtF1.Enabled := True;
  edtF2.Enabled := True;
  //LED1.StyleOnColor := clGreen;
  tkbLeftLevel.Enabled := True;
  tkbRightLevel.Enabled := True;
  lblLeftLevel.Enabled := True;
  lblRightLevel.Enabled := True;
  chkLeft.Enabled := True;
  chkRight.Enabled := True;
  hWave_out := 0;
  closed := true;
  If closing Then
    Close;
End;

Function TfrmToneGenerator.get_octave(f:
  extended): integer;
// This function is designed to find out which in octave a
// given frequency lies.  On a Pentium 100 it takes about 2us
Const
  log2 = 0.301029995664;                // use this for octave markers
  half_log2 = 0.150514997832;           // and this for half-octave markers
Begin
  Result := Trunc(Log10(f) / half_log2);
End;

Procedure TfrmToneGenerator.build_sine_table(magnitude: extended; table: PSineTable);
Var
  i: integer;
  quarter_table: integer;
  half_table: integer;
  x: integer;
Begin                                   { tkbRightLevel and tbkLeftLever max were 26...   }
  // Assume 16-bit audio goes from -32767..32767, avoids clipping.
  // There are only 2^15 samples here, this simplfies the subsequent angle
  // calculation but might restrict the dynamic range produced with noise
  // sidebands.  However, in the quality of equipment likely to be
  // encountered this won't matter.  You've got the source code, so
  // you can alter this if you like.
  half_table := sine_table_samples Div
    2;
  quarter_table := half_table Div 2;
  table^[0] := 0;
  x := round(magnitude * 32767.0);
  table^[quarter_table] := x;
  table^[half_table] := 0;
  table^[half_table + quarter_table] := -x;
  For i := 1 To quarter_table - 1 Do
  Begin
    x := round(magnitude * (32767.0 * sin(2.0 * i * Pi / sine_table_samples)));
    table^[i] := x;
    table^[half_table - i] := x;
    table^[half_table + i] := -x;
    table^[sine_table_samples - i] := -x;
  End;
End;

Procedure TfrmToneGenerator.build_left_sine_table;
Begin
  If left_sine_table_valid Then
    Exit;                               // nothing to do

  build_sine_table(left_amplitude, left_sine_table);
  present_left_amplitude := left_amplitude;
  left_sine_table_valid := True;
End;

Procedure
  TfrmToneGenerator.build_right_sine_table;
Begin
  If right_sine_table_valid Then
    Exit;                               // nothing to do

  // invert the sinewave by negating the amplitude
  If out_level = phase_reverse Then
    build_sine_table(-right_amplitude, right_sine_table)
  Else
    build_sine_table(right_amplitude, right_sine_table);
  present_right_amplitude := right_amplitude;
  right_sine_table_valid := True;
End;

Procedure
  TfrmToneGenerator.fill_buffer_with_sinewave(
  sine_table: PSineTable; bfr: pBuffer;
  f: extended;
  Var angle: integer; index, samples:
  integer);
// Fills a section of 2-channel buffer with sinewave.  The angle parameter is
// updated so that phase continuity is maintained between calls to this routine
// If the right-hand sine table is given as the parameter, the buffer is
// written with a one sample offset, i.e. the right channel
Const
  fract_bits = 15;
Var
  sample: integer;                      // looping over the required samples
  d_angle: integer;                     // 32-bit number, with 15 fractional bits, i.e. 17.15
  max_angle: integer;                   // maximum number of samples in the sine table
  w: audio_sample;                      // one single sample
Begin
  // Compute the angular step per sample corresponding to the desired frequency
  d_angle := round((sine_table_samples Shl fract_bits) * f / sample_rate);

  // This is the maximum number of samples in the sine table
  max_angle := (sine_table_samples Shl fract_bits) - 1;

  // point index to right-hand sample if required
  If sine_table = right_sine_table Then
    Inc(index);
  For sample := 0 To samples - 1 Do
  Begin
    w := sine_table^[angle Shr fract_bits]; // get current sine value
    bfr^[index] := w;                   // store it in the caller's buffer
    Inc(index, 2);                      // point past next Left or Right
    Inc(angle, d_angle);                // bump the angle
    angle := angle And max_angle;       // wrap to 360 degrees
  End;
End;

Function
  TfrmToneGenerator.fill_single_sweep_bfr(bfr: pBuffer; num_freqs: integer): integer;
// This procedure fills a single buffer with a frequency sweep.
// To allow for oscilloscope retrace and retrigger time, the buffer
// is prefixed with about 25% duration of silence.
// Both log and linear sweeps can be provided
// Returns the number of samples in the buffer
Var
  sample, chunk_samples, retrace_steps: integer;
  i, n_freq: integer;
  l_angle, r_angle: integer;
Begin
  // for linear sweep, compute the frequency step
  f_step := (f_max + 0.01 - f_min) / (num_freqs - 1);

  // for log sweep, compute the frequency ratio per step
  f_ratio := exp(ln(f_max / f_min) / (num_freqs - 1));

  retrace_steps := num_freqs Div 3;     // allow about 25% retrace time
  chunk_samples := buffer_bytes Div (2 * (num_freqs + retrace_steps));
  sample := 0;
  l_angle := 0;                         // save angle to keep phase continuous
  r_angle := 0;                         // save angle to keep phase continuous
  fl := f_min;
  fr := f_min;

  // for all buffer chunks, including silence
  For n_freq := 1 To retrace_steps + num_freqs Do
  Begin
    If n_freq <= retrace_steps Then
      For i := 0 To chunk_samples - 1 Do // over the entire chunk
      Begin
        bfr^[sample] := 0;              // insert silence - left sample
        Inc(sample);                    // point to right sample
        bfr^[sample] := 0;              // insert silence - right sample
        Inc(sample);                    // point to next left sample
      End
    Else
    Begin
      // stuff sinewave into this chunk
      fill_buffer_with_sinewave(left_sine_table, bfr, fl, l_angle, sample, chunk_samples);
      fill_buffer_with_sinewave(right_sine_table, bfr, fr, r_angle, sample, chunk_samples);
      Inc(sample, 2 * chunk_samples);
      // compute next frequency according to the sweep mode
      If log_lin = linear Then
        fl := fl + f_step
      Else
        fl := fl * f_ratio;
      fr := fl;
    End;
  End;

  Result := sample Div 2;
End;

Function
  TfrmToneGenerator.fill_white_noise_bfr(bfr:
  pBuffer): integer;
// This procedure fills a single buffer with white noise
// Returns the number of audio samples in the buffer
Var
  sample: integer;
  sample_pos: integer;
  samples: integer;
  l_value: integer;
  r_value: integer;
  l_magnitude: extended;
  r_magnitude: extended;
  value: extended;
Begin
  // note the amplitude required and record that this has been set
  l_magnitude := left_amplitude;
  present_left_amplitude := l_magnitude;
  r_magnitude := right_amplitude;
  present_right_amplitude := r_magnitude;

  // for out-of-phase, invert the right channel
  If out_level = phase_reverse Then
    r_magnitude := -r_magnitude;

  samples := buffer_bytes Div 2;
  sample_pos := 0;
  For sample := 0 To samples - 1 Do
  Begin
    value := Random * 65536.0 - 32768.0;
    l_value := Round(l_magnitude * value);
    r_value := Round(r_magnitude * value);
    bfr^[sample_pos] := l_value;        // set left sample
    Inc(sample_pos);                    // point to right sample
    bfr^[sample_pos] := r_value;        // set right sample
    Inc(sample_pos);                    // point to next left sample
  End;
  Result := samples;
End;

Function
  TfrmToneGenerator.fill_pink_noise_bfr(bfr:
  pBuffer): integer;
// This procedure fills a single buffer with white noise
// Returns the number of audio samples in the buffer
Var
  sample: integer;
  sample_pos: integer;
  samples: integer;
  l_value: integer;
  r_value: integer;
  l_magnitude: extended;
  r_magnitude: extended;
  value: extended;
Begin
  exit;                                 //  no pink
  Result := 0;
  If pink_noise_buffer = Nil Then
    read_pink_noise_file(ExtractFilePath(Application.ExeName) + pink_noise_filename);

  If pink_noise_buffer = Nil Then
    Exit;

  // note the amplitude required and record that this has been set
  l_magnitude := left_amplitude;
  present_left_amplitude := l_magnitude;
  r_magnitude := right_amplitude;
  present_right_amplitude := r_magnitude;

  // for out-of-phase, invert the right channel
  If out_level = phase_reverse Then
    r_magnitude := -r_magnitude;

  samples := buffer_bytes Div 2;
  sample_pos := 0;
  For sample := 0 To samples - 1 Do
  Begin
    value := pink_noise_buffer^[sample];
    l_value := Round(l_magnitude * value);
    r_value := Round(r_magnitude * value);
    bfr^[sample_pos] := l_value;        // set left sample
    Inc(sample_pos);                    // point to right sample
    bfr^[sample_pos] := r_value;        // set right sample
    Inc(sample_pos);                    // point to next left sample
  End;
  Result := samples;
End;

Procedure TfrmToneGenerator.FormCloseQuery(Sender:
  TObject; Var CanClose: Boolean);
Begin
  stop_sweep;
  shutoff := true;
End;

Procedure
  TfrmToneGenerator.btnStartKeyDown(Sender: TObject; Var Key: Word;
  Shift: TShiftState);
Begin
  Case Key Of
    VK_PRIOR: direction := up;          // Page Up key
    VK_NEXT: direction := down;         // Page Down key
  End;
End;

Procedure
  TfrmToneGenerator.tkbLeftFrequencyChange(Sender:
  TObject);
Begin
  // Compute the frequency corresponding to the trackbar setting.
  // Note that trackbar is treated in a log or linear basis
  // according to the current mode.
  With tkbLeftFrequency Do
  Begin
    // get the left channel frequency
    If log_lin = linear Then
      fl := f_min + (f_max - f_min) * (Max - Position) / (Max - Min)
    Else
      fl := f_min * exp(ln(f_max / f_min) * (Max - Position) / (Max
        - Min));
    lblFLeft.Caption := Format('%.0f Hz', [fl]); // display the freq
    If locked_frequencies Then          // make right the same
      If Position <> tkbRightFrequency.Position Then // is it different?
      Begin
        tkbRightFrequency.Position := Position; // no - update position
        tkbRightFrequency.OnChange(self); // and tell the control
        fr := fl;                       // record the right freq
      End;
  End;
End;

Procedure
  TfrmToneGenerator.tkbRightFrequencyChange(Sender:
  TObject);
Begin
  With tkbRightFrequency Do
  Begin
    If log_lin = linear Then
      fr := f_min + (f_max - f_min) * (Max - Position) / (Max - Min)
    Else
      fr := f_min * exp(ln(f_max / f_min) * (Max - Position) / (Max - Min));
    lblFRight.Caption := Format('%.0f Hz', [fr]);
    If locked_frequencies Then
      If Position <> tkbLeftFrequency.Position Then
      Begin
        tkbLeftFrequency.Position := Position;
        tkbLeftFrequency.OnChange(self);
        fl := fr;
      End;
  End;
End;

Procedure
  TfrmToneGenerator.tkbLeftLevelChange(Sender:
  TObject);
Begin
  With tkbLeftLevel Do
  Begin
    If out_level <> independent Then    // we should make Left = Right
    Begin
      If Position <> tkbRightLevel.Position Then // is it different?
      Begin
        tkbRightLevel.Position := Position; // yes - update the position
        tkbRightLevelChange(self);      // wake up the control
      End;
    End;
  End;
  level_changed;                        // update as required
End;

Procedure
  TfrmToneGenerator.tkbRightLevelChange(Sender:
  TObject);
Begin
  With tkbRightLevel Do
  Begin
    If out_level <> independent Then
    Begin
      If Position <> tkbLeftLevel.Position Then
      Begin
        tkbLeftLevel.Position := Position;
        tkbLeftLevelChange(self);
      End;
    End;
  End;
  level_changed;
End;

Procedure
  TfrmToneGenerator.grpChannelsClick(Sender: TObject);
Begin
  out_level := out_levels(grpChannels.ItemIndex);
  left_sine_table_valid := False;       // force a recalculation
  right_sine_table_valid := False;      // on both channels
End;

Procedure TfrmToneGenerator.chkLeftClick(Sender: TObject);
// handle a click on either output enable check boxes
Begin
  level_changed;
End;

Procedure
  TfrmToneGenerator.chkLockFrequenciesClick(Sender: TObject);
Begin
  locked_frequencies := chkLockFrequencies.Checked;
End;

Procedure TfrmToneGenerator.edtF1Change(Sender: TObject);
Begin
  lblFMinR.Caption := edtF1.Text;
  lblFMinL.Caption := edtF1.Text;
End;

Procedure TfrmToneGenerator.edtF2Change(Sender: TObject);
Begin
  lblFMaxR.Caption := edtF2.Text;
  lblFMaxL.Caption := edtF2.Text;
End;

Procedure TfrmToneGenerator.Exit1Click(Sender: TObject);
Begin
  Close;
End;

Function
  TfrmToneGenerator.read_pink_noise_file(Const filename: String): boolean;
Var
  h: HMMIO;
  wave_chunk: TMMCKINFO;
  subchunk: TMMCKINFO;
  format: PWaveFormat;
Begin
  exit;                                 //  Debug exit
  Result := False;
  pink_noise_buffer := Nil;

  h := mmioOpen(PChar(filename), Nil, MMIO_READ);
  If h = 0 Then
    ShowMessage('Error opening pink noise wave file (' + filename + ')')
  Else
  Begin
    wave_chunk.fccType := mmioStringToFOURCC('WAVE', 0);
    If mmioDescend(h, @wave_chunk, Nil, MMIO_FINDRIFF) <> 0 Then
      ShowMessage('File: ' + filename + ' is not a valid WAVE file')
    Else
    Begin
      subchunk.ckid := mmioStringToFOURCC('fmt ', 0);
      If mmioDescend(h, @subchunk, @wave_chunk, MMIO_FINDCHUNK) <> 0 Then
        ShowMessage('WAVE file: ' + filename + ' has no fmt chunk')
      Else
      Begin
        GetMem(format, subchunk.cksize);
        mmioRead(h, PChar(format), subchunk.cksize);
        mmioAscend(h, @subchunk, 0);
        subchunk.ckid := mmioStringToFOURCC('data', 0);
        If mmioDescend(h, @subchunk, @wave_chunk, MMIO_FINDCHUNK) <> 0 Then
          ShowMessage('WAVE file: ' + filename + ' has no data chunk')
        Else
        Begin
          // check it's 16-bit, mono, at 44.1KHz
          With format^ Do
            If (wFormatTag <> WAVE_FORMAT_PCM) Or (nChannels <> 1)
              Or
              (nSamplesPerSec <> sample_rate) Or (nAvgBytesPerSec <> sample_rate * 2)
              Or
              (nBlockAlign <> 2) Then
              ShowMessage('WAVE file: ' + filename + ' is not 44.1KHz mono')
            Else
              If
                subchunk.cksize < SizeOf(TMonoBuffer) Then
                ShowMessage('WAVE file: ' + filename + ' is too short')
              Else
              Begin
                GetMem(pink_noise_buffer, SizeOf(TMonoBuffer));
                If pink_noise_buffer = Nil Then
                  ShowMessage('Failed to get memory for pink noise buffer')
                Else
                  mmioRead(h, PChar(pink_noise_buffer), SizeOf(TMonoBuffer));
              End;
        End;
        FreeMem(format);
      End;
    End;
    // finished reading the MMIO wave file
    mmioClose(h, 0);
  End;
End;

End.

